home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / flow / tabent.for < prev    next >
Text File  |  1992-07-31  |  3KB  |  94 lines
  1.       SUBROUTINE TABENT(IPASS)
  2. C! Enter data into tables
  3.       INCLUDE 'params.h'
  4.       INCLUDE 'tables.h'
  5.       INCLUDE 'floppy.h'
  6.       INCLUDE 'lunits.h'
  7.       INTEGER SEARCH
  8.       EXTERNAL SEARCH
  9.       CHARACTER*(LCDOIF) CMNT,CDOIF
  10. C
  11.       IF(IPASS.NE.1) GOTO 100
  12.       IF(NPROC+NENT.GT.MAXPRO) GOTO 900
  13.       IF(NCOMM+NCOM.GT.MAXCOM) GOTO 910
  14.       DO 10 IN=1,NENT
  15.         PROCED_NAME(NPROC+IN) = CALLER(IN)
  16.         CMNT = '      '
  17.         IF(LENOCC(CMMNT).NE.0) THEN
  18.           CMNT = ' '
  19.           DO 55 IC=1,LENOCC(CMMNT)
  20.             IF(CMMNT(IC:IC).NE.' ') THEN
  21.               IF(IC.LT.LENOCC(CMMNT)) CMNT = CMMNT(IC:)
  22.               GOTO 56
  23.             ENDIF
  24.    55     CONTINUE
  25.    56     CONTINUE
  26.         ENDIF
  27.         PROCED_DESCRIP(NPROC+IN) = CMNT
  28. C
  29. C loop over common block names
  30. C
  31.         DO 20 IC=1,NCOM
  32.           DO 21 ICO=1,NCOMM
  33.             IF(COMMON_NAME(ICO).EQ.CNAMES(IC)) THEN
  34.               COMMON_USED(NPROC+IN,ICO) = 'Y'
  35.               IF(UNUSED(IC).EQ.'!')
  36.      &            COMMON_USED(NPROC+IN,ICO) = 'N'
  37.               GOTO 22
  38.             ENDIF
  39.    21     CONTINUE
  40.           NCOMM = NCOMM + 1
  41.           COMMON_NAME(NCOMM) = CNAMES(IC)
  42.           COMMON_USED(NPROC+IN,NCOMM) = 'Y'
  43.           IF(UNUSED(IC).EQ.'!')
  44.      &       COMMON_USED(NPROC+IN,NCOMM) = 'N'
  45.    20   CONTINUE
  46.    22   PROCED_NCALLS(NPROC+IN) = KALL
  47.         DO 50 ICL=1,KALL
  48. C
  49. C compose doif string
  50. C
  51.           CDOIF(:) = ' '
  52.           ILDO = MIN(KALLDO(ICL),LCDOIF)
  53.           DO 30 IDO=1,ILDO
  54.             CDOIF(IDO:IDO) = '('
  55.    30     CONTINUE
  56.           ILIF = MIN(LCDOIF-ILDO,KALLIF(ICL))
  57.           DO 31 IIF=1,ILIF
  58.             CDOIF(ILDO+IIF:ILDO+IIF) = '?'
  59.    31     CONTINUE
  60.           PROCED_DOIF(NPROC+IN,ICL) = CDOIF
  61.    50   CONTINUE
  62.    10 CONTINUE
  63.       NPROC = NPROC + NENT
  64.       RETURN
  65. C
  66. C second pass for external names
  67. C
  68.   100 CONTINUE
  69.       DO 110 IN=1,NENT
  70.         IF(KALL.LE.0) GOTO 110
  71.         IPNAM = SEARCH(CALLER(IN))
  72.         DO 120 IC=1,KALL
  73.           IPNAM2 = SEARCH(CALLED(IC))
  74.           IF(IPNAM2.EQ.0) THEN
  75.             NPROC = NPROC + 1
  76.             IPNAM2 = NPROC
  77.             PROCED_NAME(NPROC) = CALLED(IC)
  78.             PROCED_DESCRIP(NPROC) = 'External'
  79.             PROCED_EXTERN(NPROC) = .TRUE.
  80.             PROCED_NCALLS(NPROC) = 0
  81.             PROCED_NCALLEDBY(NPROC) = 0
  82.           ENDIF
  83.           PROCED_CALLS(IPNAM,IC) = IPNAM2
  84.           NCALLEDBY = PROCED_NCALLEDBY(IPNAM2) + 1
  85.           PROCED_NCALLEDBY(IPNAM2) = NCALLEDBY
  86.   120   CONTINUE
  87.   110 CONTINUE
  88.       RETURN
  89.   900 WRITE(LOUT,'(A)') ' TABENT : MAXIMUM NO. OF PROCEDURES EXCEEDED'
  90.       STOP 2
  91.   910 WRITE(LOUT,'(A)') ' TABENT : MAXIMUM NO. OF COMMONS EXCEEDED'
  92.       STOP 3
  93.       END
  94.